Необходимо выяснить вероятные причины ухода клиентов онлайн-магазина и попытаться смоделировать действия, которые могла бы предпринять компания, чтобы сократить отток.
Для анализа будем использовать базу данных покупателей онлайн-магазина.
library(dplyr)
library(ggplot2)
library(DBI)
library(RMariaDB)
library(rpart)
library(rpart.plot)
library(partykit)
library(caret)
library(tidymodels)
library(vip)
library(plotly)
# Клиенты онлайн-магазина
con <- dbConnect(RMariaDB::MariaDB(),
user='student2022minor',
password='DataMinorHSE!2020',
dbname='ecommerce',
host='hsepiterdata-1.cqq6v5igyw1z.us-east-2.rds.amazonaws.com',
port = 3315)
Рассмотрим, какие клиенты совершают больше всего заказов в зависимости от семейного статуса и гендера.
dbGetQuery(con, "SELECT MaritalStatus, SUM(OrderCount) as Orders FROM profile LEFT JOIN useraccount ON profile.CustomerId = useraccount.CustomerId GROUP BY MaritalStatus")
## MaritalStatus Orders
## 1 Divorced 2540
## 2 Married 8825
## 3 Single 4794
dbGetQuery(con, "SELECT Gender, SUM(OrderCount) as Orders FROM profile LEFT JOIN useraccount ON profile.CustomerId = useraccount.CustomerId GROUP BY Gender")
## Gender Orders
## 1 Female 6604
## 2 Male 9555
Отбираем мужчин с семейным статусом Married, так как они совершали больше всего заказов. В данных преобразуем переменные в фактор и удалим пустые значения.
activeUse = dbGetQuery(con, "SELECT OrderCount, Tenure, HourSpendOnApp, DaySinceLastOrder, NumberOfDeviceRegistered, PreferredLoginDevice, PreferredPaymentMode, NumberOfAddress, CouponUsed, CashbackAmount, Complain, SatisfactionScore, Churn FROM profile LEFT JOIN useraccount ON profile.CustomerId = useraccount.CustomerId WHERE (Gender = 'Male' AND MaritalStatus = 'Married')")
# это нужно для сравнения распределения оттока по общим данным и по подгруппе
query_full = dplyr::tbl(con, "useraccount") %>% collect()
dbDisconnect(con)
# Преобразование переменных в фактор, удаление na
activeUse = activeUse %>% mutate_if(is.character, as.factor)
activeUse$Churn = as.factor(activeUse$Churn)
activeUse = na.omit(activeUse)
Распределение целевой переменной в подгруппе несильно отличается от общих данных: процент оттока немного ниже (14.4 % в подгруппе, 20.2 % в общих данных)
ggplot() + geom_bar(data = query_full, aes(x = factor(Churn)), alpha = 0.7, fill = "lightblue") + geom_bar(data = activeUse, aes(x = Churn), alpha = 0.7) + xlab("Уход клиента (нет/да)") + ylab("Количество клиентов") + ggtitle("Распределение целевой переменной")
Построим две модели: дерево и логистическая регрессия.
test %>%
mutate(pred =log.pred$.pred_class) %>%
conf_mat(estimate = pred, truth = Churn) %>%
summary()
## # A tibble: 13 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.878
## 2 kap binary 0.330
## 3 sens binary 0.959
## 4 spec binary 0.314
## 5 ppv binary 0.907
## 6 npv binary 0.524
## 7 mcc binary 0.343
## 8 j_index binary 0.273
## 9 bal_accuracy binary 0.637
## 10 detection_prevalence binary 0.925
## 11 precision binary 0.907
## 12 recall binary 0.959
## 13 f_meas binary 0.932
По результатам оценки моделей accuracy получилась очень высокой, однако у specificity показатель довольно низкий, а значит уход клиента предсказывается недостаточно точно. Выборка несбалансирована.
Далее будем работать с моделью дерева, так как она показала большую specificity. Проведём балансировку тренировочной выборки и построим новую модель.
ggplot(data.frame(plot.pred_up)) + geom_bar(aes(x = plot.pred_up), alpha = 0.7, fill = "darkblue") + xlab("Уход клиента (нет/да)") + ylab("Количество клиентов") + ggtitle("Предсказываемое распределение целевой переменной")
После балансировки понизились accuracy и sensitivity, но сильно повысилась specificity. Попробуем выявить значимые переменные.
vip(plot.model_up)
fig <- plot_ly(test,
type='histogram',
x=~PreferredLoginDevice[Churn == 0],
bingroup=1, name = "0")
fig <- fig %>% add_trace(test,
type='histogram',
x=~PreferredLoginDevice[Churn == 1],
bingroup=1, color = I("darkred"), name = "1")
fig <- fig %>% layout(
barmode="group",
bargap=0.1, xaxis = list(title = "Тип устройства"), yaxis = list(title = "Кол-во клиентов"))
fig = fig %>% layout(title = "Отток в зависимости от предпочитаемого способа заказа")
fig
noa = ggplot(test) + geom_bar(aes(x = NumberOfAddress, fill = Churn), position = "fill") + xlab("Кол-во сохранённых адресов") + ylab("Процент оттока") + ggtitle("Отток в зависимости от кол-ва сохранённых адресов в аккаунте")
ggplotly(noa)
Итак, анализ переменных на тестовой выборке показал, что:
Тестовая выборка показывает, что люди в основном уходят на начальном этапе пользования онлайн-магазина;
Также можно заметить, что часто уходят люди, у которых сохранено большое количество адресов доставки;
Процент оттока выше среди людей, которые совершают заказы через звонки по телефону (Phone).
Для того, чтобы уменьшить отток, попробуем симулировать следующие изменения:
Увеличить время пользования приложением, т.е. попробовать удержать клиентов (например, предлагать первые три месяца бесплатной доставки);
Смотивировать людей на заказ через приложение или сайт, а не через звонки (например, предлагать скидки и купоны за заказы через сайт или приложение);
Предлагать удалять адреса, которые давно не использовались (уменьшить кол-во сохранённых адресов).
# Сравнение с оттоком в тестовой выборке
gpl = ggplot(data.frame(plot.pred_up2)) + geom_bar(aes(x = plot.pred_up2), alpha = 0.7, fill = "darkred") + geom_bar(data = test, aes(x = Churn), alpha = 0.5) + xlab("Уход клиента (нет/да)") + ylab("Количество клиентов") + ggtitle("Сравнение предсказываемого и действительного оттока")
ggplotly(gpl)
Вынесены результаты общего анализа: какая группа покупателей наиболее активна, объём наблюдений, на которых проводилось предсказание и моделирование.
Вынесены результаты симуляции изменений, насколько удалось снизить отток.
Основными переменными, влияющими на отток клиентов оказались время пользования приложением, предпочитаемый способ осуществления заказа и кол-во сохранённых адресов доставки.
Несмотря на то, что было предложено несколько стратегий уменьшения оттока, результаты повторного предсказания после симуляции не показали сильного эффекта, если сравнивать отток с тестовой выборкой. Однако при большем объёме данных эффект может быть более заметным.